home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 2: CDPD 1 / Almathera Ten on Ten - Disc 2: CDPD 1.iso / pd / 076-100 / 084 / gravitywars / options.mod < prev    next >
Text File  |  1995-03-13  |  9KB  |  312 lines
  1. IMPLEMENTATION MODULE Options;
  2. (*+,+*)
  3. (**********************************************************************
  4. ***************           Written by Ed Bartz           ***************
  5. ***************           Copyright  5/21/87            ***************
  6. ***************    This program may be redistributed    ***************
  7. ***************    or modified as long as these         ***************
  8. ***************    notices and all other references     ***************
  9. ***************    to the author remain intack.         ***************
  10. ***************    Also this may not be used for        ***************
  11. ***************    profit by anyone without the         ***************
  12. ***************    express permission of the author.    ***************
  13. **********************************************************************)
  14.  
  15. FROM Intuition  IMPORT
  16.      IntuitionName, IntuitionBase, WindowPtr, ScreenPtr, Menu, Window,
  17.      ItemFlagSet, ItemEnabled, MenuToggle, MenuItem, ItemText;
  18. FROM RandomNumbers IMPORT Random;
  19. FROM MathLib0 IMPORT real,entier,sqrt;
  20. FROM GW IMPORT 
  21.        Pl, Mdata, Shell, DrawPlanet, Distance,  Stars, DrawLine,
  22.        DrawShip;
  23. FROM MyWindow IMPORT
  24.        OpenIOWin, CloseIOWin, ReadMouse;
  25. FROM Rasters IMPORT SetRast;
  26. FROM Console IMPORT  
  27.        OpenRConsole, CloseRConsole, PutChar, PutStr, GetChar, GetStr,
  28.        QueueRead,  Conport;
  29. FROM M2Conversions IMPORT 
  30.        ConvertCardinal, ConvertReal, ConvertToReal, ConvertToCardinal;
  31. FROM Pens IMPORT SetAPen, WritePixel, ReadPixel;
  32.  
  33. PROCEDURE DeletePlanet(wp: WindowPtr;VAR pl: ARRAY OF Pl;VAR Pnum: CARDINAL);
  34.       VAR
  35.         i,x,y : CARDINAL;
  36.  
  37.       BEGIN 
  38.         ReadMouse(wp,x,y);
  39.         i:= IdentifyP(x,y,Pnum,pl);
  40.         DeletePlanet1(wp,pl,i,Pnum);
  41.     END DeletePlanet;
  42.   (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  43. PROCEDURE MakePlanet(wp: WindowPtr;VAR Sh,pl: ARRAY OF Pl;VAR Pnum,ptype: CARDINAL);
  44.       VAR
  45.         ok : BOOLEAN;
  46.         density,i,x,y : CARDINAL;
  47.         temp : Pl;
  48.         r3 : REAL;
  49.         mass : ARRAY [0..2] OF REAL;
  50.  
  51.       BEGIN
  52.         mass[0]:=0.02;
  53.         mass[1]:=0.025;
  54.         mass[2]:=0.03;
  55.         ReadMouse(wp,x,y);
  56.         i:= Pnum;
  57.         IF i<15 THEN
  58.           pl[i].x:=x;
  59.           pl[i].y:=y;
  60.           ReadMouse(wp,x,y);
  61.           temp.x:=x;
  62.           temp.y:=y;
  63.           pl[i].r:= Distance(pl[i],temp); 
  64.           IF pl[i].r>255 THEN pl[i].r :=255; END;
  65.           r3:= real(pl[i].r);
  66.           IF Room(pl,Sh,pl[i],Pnum,0) THEN
  67.             r3:=r3*r3*r3;
  68.             density:= Random(3);
  69.             pl[i].color:= (density*4)+4;
  70.             pl[i].m:=r3*mass[density];
  71.             WITH pl[i] DO
  72.               DrawPlanet(x,y,r,color,ptype,wp);
  73.             END;
  74.             Pnum:=i+1;
  75.           END;
  76.         END;
  77.      END MakePlanet;
  78.   (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  79.     PROCEDURE ChangePlanet(wp: WindowPtr;VAR pl: ARRAY OF Pl;Pnum,ptype: CARDINAL);
  80.       VAR
  81.         c,x,y,i : CARDINAL;
  82.  
  83.       BEGIN
  84.         ReadMouse(wp,x,y);
  85.         i:= IdentifyP(x,y,Pnum,pl);
  86.         c:= pl[i].color;
  87.         IF c=4 THEN c:=8;
  88.         ELSE IF c=8 THEN c:=12;
  89.           ELSE IF c=12 THEN c:=4; END;
  90.           END;
  91.         END;
  92.         pl[i].color:=c;
  93.         WITH pl[i] DO
  94.           DrawPlanet(x,y,r,color,ptype,wp);
  95.         END;
  96.      END ChangePlanet;
  97.   (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  98.     PROCEDURE MoveShip(wp: WindowPtr;VAR Sh,pl: ARRAY OF Pl;Pnum :CARDINAL);
  99.       VAR
  100.         x,y,i : CARDINAL;
  101.         c : CHAR;
  102.         ok : BOOLEAN;
  103.         temp : Pl;
  104.  
  105.       BEGIN
  106.         ReadMouse(wp,x,y);
  107.         i:= IdentifyS(x,y,Sh);
  108.         IF i< 2 THEN
  109.           deleteship(wp,Sh[i]);
  110.           ReadMouse(wp,x,y);
  111.           temp.x:=x;
  112.           temp.y:=y;
  113.           temp.r:=Sh[i].r;
  114.           ok:= Room(pl,Sh,temp,Pnum,(1+i));
  115.           IF ok THEN
  116.             Sh[i].x:= x;
  117.             Sh[i].y:= y;
  118.           END;
  119.           DrawShip(Sh[0].x,Sh[0].y,Sh[1].x,Sh[1].y,wp);
  120.         END;
  121.       END MoveShip;
  122.   (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  123.       PROCEDURE deleteship(wp: WindowPtr; p: Pl);
  124.         CONST
  125.           round = 0.83;
  126.  
  127.         VAR
  128.           i,j,k,itr,nx,ny,x1,x2,y1,y2 : INTEGER;
  129.  
  130.         BEGIN
  131.           WITH p DO
  132.             FOR ny:=0 TO 7 DO
  133.               x1:=x-18;
  134.               x2:=x+18;
  135.               y1:=y-ny;
  136.               y2:=y+ny;
  137.               IF x1<0 THEN x1:=0; END;
  138.               IF y1<0 THEN y1:=0; END;
  139.               IF x2>639 THEN x2:=639; END;
  140.               IF y2>399 THEN y2:=399; END;
  141.               DrawLine(x1,y1,x2,y1,0,wp);
  142.               DrawLine(x1,y2,x2,y2,0,wp);
  143.             END;
  144.             SetAPen(wp^.RPort,1);
  145.             FOR i:= 0 TO 3 DO
  146.               j:= INTEGER(Random(36))-18;
  147.               k:= INTEGER(Random(14))-7;
  148.               itr:= ReadPixel(wp^.RPort,x+j,y+k);
  149.               IF itr=0 THEN
  150.                 WritePixel(wp^.RPort,x+j,y+k);
  151.               END;
  152.             END;
  153.           END;
  154.         END deleteship;
  155.   (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  156. PROCEDURE MovePlanet(wp: WindowPtr;VAR Sh,pl: ARRAY OF Pl;Pnum,ptype :CARDINAL);
  157.       VAR
  158.         x,y,i : CARDINAL;
  159.         temp,temp1 : Pl;
  160.         ok : BOOLEAN;
  161.  
  162.       BEGIN
  163.         ReadMouse(wp,x,y);
  164.         i:= IdentifyP(x,y,Pnum,pl);
  165.         temp1.x:= pl[i].x;
  166.         temp1.y:= pl[i].y;
  167.         temp1.r:= pl[i].r;
  168.         temp1.color:= pl[i].color;
  169.         temp1.m:= pl[i].m;
  170.         DeletePlanet1(wp,pl,i,Pnum);
  171.         ReadMouse(wp,x,y);
  172.         temp.x:=x;
  173.         temp.y:=y;
  174.         temp.r:=temp1.r;
  175.         ok:= Room(pl,Sh,temp,Pnum,0);
  176.         IF ok THEN 
  177.           pl[Pnum].x:= x;
  178.           pl[Pnum].y:= y;
  179.         ELSE
  180.           pl[Pnum].x:=temp1.x;
  181.           pl[Pnum].y:=temp1.y;
  182.         END;
  183.           pl[Pnum].r:=temp1.r;
  184.           pl[Pnum].m:=temp1.m;
  185.           pl[Pnum].color:=temp1.color;
  186.         WITH pl[Pnum] DO
  187.           DrawPlanet(x,y,r,color,ptype,wp);
  188.         END;
  189.         Pnum:=Pnum+1;
  190.       END MovePlanet;
  191.   (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  192.  PROCEDURE DeletePlanet1(wp: WindowPtr;VAR p: ARRAY OF Pl;VAR l,Pnum:CARDINAL);
  193.  
  194.         CONST
  195.           round = 0.83;
  196.  
  197.         VAR
  198.           i,j,k,itr,nx,ny : INTEGER;
  199.  
  200.         BEGIN
  201.           IF Pnum#0 THEN
  202.             WITH p[l] DO
  203.               DrawPlanet(x,y,r,1,0,wp);
  204.               SetAPen(wp^.RPort,1);
  205.               FOR i:= 0 TO (r DIV 5) DO
  206.                 j:= INTEGER(Random(2*r))-r;
  207.                 k:= INTEGER(Random(2*r))-r;
  208.                 itr:= ReadPixel(wp^.RPort,x+j,y+k);
  209.                 IF itr=0 THEN
  210.                   WritePixel(wp^.RPort,x+j,y+k);
  211.                 END;
  212.               END;
  213.             END;
  214.             Pnum:= Pnum-1;
  215.             FOR i:= l TO Pnum-1 DO
  216.               p[i].x:= p[i+1].x;
  217.               p[i].y:= p[i+1].y;
  218.               p[i].r:= p[i+1].r;
  219.               p[i].m:= p[i+1].m;
  220.               p[i].color:= p[i+1].color;
  221.             END;
  222.           END;
  223.         END DeletePlanet1;
  224.   (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  225. PROCEDURE CleanScreen (wp: WindowPtr;VAR Sh,pl: ARRAY OF Pl;Pnum,ptype: CARDINAL);
  226.        
  227.        VAR
  228.          i : CARDINAL;
  229.           
  230.        BEGIN
  231.          SetRast(wp^.RPort,0);
  232.          Stars(wp);
  233.          DrawShip(Sh[0].x,Sh[0].y,Sh[1].x,Sh[1].y,wp);
  234.          WHILE (Pnum>0) DO
  235.            Pnum:= Pnum-1;
  236.            WITH pl[Pnum] DO
  237.              DrawPlanet(x,y,r,color,ptype,wp);
  238.            END;
  239.          END;
  240.        END CleanScreen;
  241.   (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  242.  PROCEDURE IdentifyP(x,y,Pnum: CARDINAL; VAR pl: ARRAY OF Pl): CARDINAL;
  243.          VAR
  244.            j,l : INTEGER;
  245.            Mouse : Pl;
  246.            i,k : CARDINAL;
  247.  
  248.          BEGIN
  249.            Mouse.x := INTEGER(x);
  250.            Mouse.y := INTEGER(y);
  251.            j:= 10000;
  252.            k:= 100;
  253.            FOR i:= 0 TO (Pnum-1) DO
  254.              l:=Distance(Mouse,pl[i]);
  255.              IF j > ABS(l) THEN
  256.                k:= i;
  257.                j:= ABS(l);
  258.              END;
  259.            END;
  260.            RETURN k;
  261.         END IdentifyP;
  262.   (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  263.  PROCEDURE IdentifyS(x,y: CARDINAL; VAR Sh: ARRAY OF Pl): CARDINAL;
  264.          VAR
  265.            j,l : INTEGER;
  266.            Mouse : Pl;
  267.            i,k : CARDINAL;
  268.  
  269.          BEGIN
  270.            Mouse.x := INTEGER(x);
  271.            Mouse.y := INTEGER(y);
  272.            j:= 10000;
  273.            k:= 100;
  274.            FOR i:= 0 TO 1 DO
  275.              l:=Distance(Mouse,Sh[i]);
  276.              IF j > ABS(l) THEN
  277.                k:= i;
  278.                j:= ABS(l);
  279.              END;
  280.            END;
  281.            IF j<50 THEN
  282.              RETURN k;
  283.            ELSE 
  284.              RETURN 2;
  285.            END;
  286.         END IdentifyS;
  287.   (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  288. PROCEDURE Room(VAR Pln,Sh: ARRAY OF Pl;new: Pl;Pn,sh: CARDINAL): BOOLEAN;
  289.        VAR
  290.          i,k : INTEGER;
  291.          ok : BOOLEAN;
  292.  
  293.        BEGIN
  294.          ok:=TRUE;
  295.          FOR k:=0 TO (Pn-1) DO
  296.            i:= Distance(Pln[k],new);
  297.            IF (i<(Pln[k].r+new.r)) THEN ok:=FALSE;END;
  298.          END;
  299.          IF sh<1 THEN
  300.            FOR k:=0 TO 1 DO
  301.              i:= Distance(Sh[k],new);
  302.              IF (i<(Sh[k].r+new.r)) THEN ok:=FALSE;END;
  303.            END;
  304.          ELSE
  305.          i:= Distance(Sh[1-(sh-1)],new);
  306.          IF (i<(Sh[1-(sh-1)].r+new.r)) THEN ok:=FALSE;END;
  307.          END;
  308.        RETURN ok;
  309.      END Room;
  310.  
  311.  END Options.
  312.